home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / textFill.tcl < prev    next >
Encoding:
Text File  |  1997-12-05  |  12.8 KB  |  458 lines  |  [TEXT/ALFA]
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 26/11/96 {7:08:34 pm} 
  6. #                                last update: 16/5/96 
  7. #  Author: Vince Darley
  8. #  E-mail: <mailto:vince@das.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #     www: <http://www.fas.harvard.edu/~darley/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  # Here's a    brief explanation of the smart fillParagraph routines
  17.  # 
  18.  # 'fillParagraph'
  19.  #       If there's a    selection, then    fill all paragraphs    in that
  20.  #       selection. If not then fill the paragraph surrounding the
  21.  #       insertion point.    The    definition of a    'paragraph'    may    be
  22.  #       mode    dependent (see paraStart, paraFinish)
  23.  #       
  24.  # 'fillOneParagraph'
  25.  #       Fills the single    paragraph surrounding the insertion    point.
  26.  #       If called with parameter    '0', it    doesn't    bother to remember
  27.  #       where the insertion point was, which    makes multiple paragraph
  28.  #       fills quicker when called by    'fillParagraph'
  29.  #       
  30.  # 'rememberWhereYouAre'
  31.  #       Given the start of a    paragraph and the point    to remember,
  32.  #       this    creates    a record stored    in '__g_remember_pos' so that
  33.  #       the following function can find that    spot later,    even after
  34.  #       the paragraph has had space/tabs/new-lines meddled with.
  35.  #       
  36.  # 'goBackToWhereYouWere'
  37.  #       Given the beginning and end of a    selection, where the beginning
  38.  #       corresponds to a    previous call of 'rememberWhereYouAre',    this
  39.  #       procedure will move the insertion point to the correct place.
  40.  #       
  41.  # 'texParaCommands'
  42.  #       A variable containing the bulk of a regexp for paragraph
  43.  #       indicators in 'TeX' mode.
  44.  #       
  45.  # 'paraStart'
  46.  #       Finds the start of the paragraph    containing the insertion point.
  47.  #       
  48.  # 'paraFinish'
  49.  #       Finds the end of    the    paragraph containing the insertion point.
  50.  ##
  51.     
  52. proc fillParagraph {} {
  53.     if {[getPos] == [selEnd]} {
  54.         fillOneParagraph
  55.     } else {    
  56.         set start [getPos]
  57.         set end [selEnd]
  58.         set p $start
  59.         while { $p < $end && $p < [maxPos]} {
  60.             goto $p
  61.             set p [fillOneParagraph 0]
  62.         }
  63.         goto $start
  64.     }
  65. }
  66.  
  67. proc rememberWhereYouAre { startPara pos } {
  68.     global __g_remember_str
  69.     set srem [expr $pos -20 < $startPara ? $startPara : $pos - 20]
  70.     set __g_remember_str [quote::Regfind [getText $srem $pos ]]
  71.     regsub -all "\[ \t\r\]+" $__g_remember_str {[ \t\r]+} __g_remember_str
  72. }
  73.  
  74. proc goBackToWhereYouWere { start end } {
  75.     global __g_remember_str
  76.     if { $__g_remember_str != "" } {
  77.         regexp -indices ".*(${__g_remember_str}).*" [getText $start $end] wholematch submatch
  78.         set p [expr [info exists submatch] ? \
  79.             [expr $start + 1 + [lindex $submatch 1]] : $end]
  80.         goto [expr $p >= $end ? $end -1 : $p]
  81.     } else {
  82.         goto $start
  83.     }
  84. }
  85.  
  86. ## 
  87.  # -------------------------------------------------------------------------
  88.  #     
  89.  #    "getLeadingIndent" --
  90.  #    
  91.  #     Find the indentation of the line containing 'pos',    and    convert    it
  92.  #     to    a minimal form of tabs followed    by spaces.    If 'size'
  93.  #     is    given, then    the    variable of    that name is set to    the    length of
  94.  #     the indent. Similarly 'halftab' can be set to half a tab.
  95.  # -------------------------------------------------------------------------
  96.  ##
  97. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  98.     # get the leading whitespace of the current line
  99.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  100.     
  101.     # convert it to minimal form: tabs then spaces, stored in 'front'
  102.     getWinInfo a
  103.     set sp [string range "              " 1 $a(tabsize) ]
  104.     regsub -all "($sp| +\t)" [eval getText $res] "\t" front
  105.     if { $size != "" } {
  106.         upvar $size ind
  107.         # get the length of the indent
  108.         regsub -all "\t" $front $sp lfront
  109.         set ind [string length $lfront]
  110.     }
  111.     if { $halftab != "" } {
  112.         upvar $halftab ht
  113.         # get the length of half a tab
  114.         set ht [string range "            " 1 [expr $a(tabsize)/2]]
  115.     }
  116.     
  117.     return $front
  118. }
  119.  
  120. ## 
  121.  # -------------------------------------------------------------------------
  122.  # 
  123.  # "fillOneParagraph" --
  124.  # 
  125.  #  Fixes: won't put a double-space after abbreviations like 'e.g.', 'i.e.'
  126.  #  
  127.  #  Works around the Alpha 'replaceText' bug.
  128.  # -------------------------------------------------------------------------
  129.  ##
  130. proc fillOneParagraph {{remember 1}} {
  131.     global leftFillColumn fillColumn doubleSpaces
  132.  
  133.     set pos [getPos]
  134.     
  135.     set start [paraStart $pos] 
  136.     set end [paraFinish $pos]
  137.     if $remember { rememberWhereYouAre $start $pos }
  138.  
  139.     # Get the leading whitespace of the current line and store length in 'left'
  140.     set front [getLeadingIndent $pos left]
  141.     # fill the text
  142.     regsub -all "\[ \t\r\]+" [string trim [getText $start $end]] " " text
  143.     # turn single spaces at end of sentences into double
  144.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  145. #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!][])'"]?) } $text {\1  } text}
  146.  
  147.     # temporarily adjust the fillColumns
  148.     set ol $leftFillColumn
  149.     set or $fillColumn
  150.     set leftFillColumn 0
  151.     set fillColumn [expr $fillColumn - $left]
  152.         
  153.     # break and indent the paragraph
  154.     regsub -all "\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  155.     # reset columns
  156.     set leftFillColumn $ol
  157.     set fillColumn  $or
  158.     
  159.     # don't replace if nothing's changed
  160.     if { "$text\r" != "\r[getText $start $end]" } {
  161.         # workaround an alpha bug
  162.         if $remember { 
  163.             getWinInfo a
  164.             if {[rowColToPos $a(currline) 0] > $start} { goto $start }
  165.         }
  166.         replaceText $start $end "[string range $text 1 end]\r"
  167.         if $remember {
  168.             goBackToWhereYouWere $start [expr $start + [string length $text]] 
  169.         }
  170.     }
  171.     
  172.     # in case we wish to fill a region
  173.     return $end
  174. }
  175.  
  176.  
  177. ## 
  178.  # -------------------------------------------------------------------------
  179.  # 
  180.  #    "paraStart"    -- "paraFinish"
  181.  # 
  182.  #     Newly simplified version with fewer regexp    '()' pairs.    Also I think
  183.  #     it    deals better with TeX comments than    the    old    regexp.
  184.  #     
  185.  #     "Start": It's pretty clear    for    non    TeX    modes how this works.  The only    
  186.  #     key is    that we    start at the beginning of the current line and look    back.  
  187.  #     We    then have a    quick check    for    whether    we found that very beginning (in 
  188.  #     which case    return it) or if not (in which case we have found the end of 
  189.  #     the previous paragraph) we move forward a line.
  190.  # 
  191.  #     "Finish": The only    addition is    the    need for an    additional check for
  192.  #     stuff which explicitly    ends lines.
  193.  #       
  194.  #    Results:
  195.  #     The start/finish position of the paragraph containing the given 'pos'
  196.  # 
  197.  # --Version--Author------------------Changes-------------------------------
  198.  #      1.1      <darley@fas.harvard.edu> Cut down on '()' pairs
  199.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  200.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  201.  #    1.4     <darley@fas.harvard.edu> Handle Tcl lists, top of file fix.
  202.  # -------------------------------------------------------------------------
  203.  ##
  204. proc paraStart {pos} {
  205.     global mode 
  206.     global ${mode}::startPara
  207.     if {$pos == [maxPos]} {incr pos -1}
  208.     set pos [lineStart $pos]
  209.     if [info exists ${mode}::startPara] {
  210.         set startPara [set ${mode}::startPara]
  211.     } else {
  212.         switch -- $mode {
  213.             "TeX" -
  214.             "Bib" {
  215.                 global texParaCommands
  216.                 set startPara {^[ \t]*$|\\\\[ \t]*$|(^|[^\\])%|\\h+line[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  217.                 append startPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  218.             } 
  219.             "HTML" {
  220.                 global htmlParaCommands
  221.                 set startPara {^[ \t]*$|</?(}
  222.                 append startPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  223.             }
  224.             default {
  225.                 set startPara {^([ \t]*|([\\%].*))$}
  226.             }
  227.         }
  228.     }
  229.  
  230.     set res [search -s -n -f 0 -r 1 -l 0 "$startPara" $pos]
  231.     if {![string length $res] || $res == "0 0" } {
  232.         # bug work-around.  Alpha fails to match '^' with start of file.
  233.         return [lindex [search -s -f 1 -r 1 {[^ \t\r\n]} 0] 0]
  234.     } elseif { [lindex $res 0] == $pos } {
  235.         return $pos
  236.     } else {
  237.         return [nextLineStart [lindex $res 0]]
  238.     }
  239.     
  240. }
  241.  
  242. proc paraFinish {pos} {
  243.     global mode
  244.     global ${mode}::endPara
  245.     set pos [lineStart $pos]
  246.     set end [maxPos]
  247.     if [info exists ${mode}::endPara] {
  248.         set endPara [set ${mode}::endPara]
  249.     } else {
  250.         switch -- $mode {
  251.             "TeX" -
  252.             "Bib" {
  253.                 global texParaCommands
  254.                 set endPara {^[ \t]*$|(^|[^\\])%|\$\$[ \t]*$|^[ \t]*(\\(}
  255.                 append endPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  256.             } 
  257.             "HTML" {
  258.                 global htmlParaCommands
  259.                 set endPara {^[ \t]*$|</?(}
  260.                 append endPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  261.             }
  262.             default {
  263.                 set endPara {^([ \t]*|([\\%].*))$}
  264.             }
  265.         }
  266.     }
  267.     
  268.     set res [search -s -n -f 1 -r 1 -l $end "$endPara" $pos]
  269.     if {![string length $res]} {return $end}
  270.     set cpos [lineStart [lindex $res 0] ]
  271.     if { $cpos == $pos } {
  272.         return [nextLineStart $cpos]
  273.     }
  274.     # A line which ends in '\\', '%...', '\hline', '\hhline'
  275.     # signifies the end of the current paragraph in TeX mode
  276.     # (the above checked for beginning of the next paragraph).
  277.     if { $mode == "TeX" || $mode == "Bib" } {
  278.         set res2 [search -s -n -f 1 -r 1 -l $end {((\\\\|\\h+line)[ \t]*|[^\\]%.*)$} $pos]
  279.         if [string length $res2] {
  280.             if { [lindex $res2 0] < $cpos } {
  281.                 return [nextLineStart [lindex $res2 0]]
  282.             }
  283.         }
  284.     }
  285.  
  286.     return $cpos
  287.     
  288. }
  289.  
  290. proc selectParagraph {} {
  291.     set pos [getPos]
  292.     set start [paraStart $pos] 
  293.     set finish [paraFinish $pos]
  294.     goto $start
  295.     select $start $finish
  296. }
  297.  
  298. proc sentenceParagraph {} {
  299.     set pos [getPos]
  300.     set start [paraStart $pos] 
  301.     set finish [paraFinish $pos]
  302.  
  303.     set t [string trim [getText $start $finish]]
  304.     set period [regexp {\.$} $t]
  305.     regsub -all "\[ \t\r\]+" $t " " text
  306.     regsub -all {\. } $text "Δ" text
  307.     set result ""
  308.     foreach line [split [string trimright $text {.}] "Δ"] {
  309.         if {[string length $line]} {
  310.             append result [breakIntoLines $line] ".\r"
  311.         }
  312.     }
  313.     if {!$period && [regexp {\.\r} $result]} {
  314.         set result [string trimright $result ".\r"]
  315.         append result "\r"
  316.     }
  317.     if {$result != [getText $start $finish]} {
  318.         replaceText $start $finish $result
  319.     }
  320.     goto $pos
  321. }
  322.  
  323. proc getEndpts {} {
  324.     if {[getPos] == [selEnd]} {
  325.         set start [getPos]
  326.         set finish [getMark]
  327.         if {$start > $finish} {
  328.             set temp $start
  329.             set start $finish
  330.             set finish $temp
  331.         }
  332.     } else {
  333.         set start [getPos]
  334.         set finish [selEnd]
  335.     }
  336.     return [list $start $finish]
  337. }
  338.  
  339.  
  340. proc fillRegion {} {
  341.     global leftFillColumn
  342.     set ends [getEndpts]
  343.     set start [lineStart [lindex $ends 0]]
  344.     set finish [lindex $ends 1]
  345.     goto $start
  346.     set text [fillText $start $finish]
  347.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  348. }
  349.     
  350. proc wrapParagraph {} {
  351.     set pos [getPos]
  352.     set start [paraStart $pos] 
  353.     set finish [paraFinish $pos]
  354.     goto $start
  355.     wrapText $start $finish
  356.     goto $pos
  357. }
  358.  
  359. proc wrapRegion {} {
  360.     set ends [getEndpts]
  361.     set start [lineStart [lindex $ends 0]]
  362.     set finish [lindex $ends 1]
  363.     if {$start == $finish} {
  364.         set finish [maxPos]
  365.     }
  366.     wrapText $start $finish
  367. }
  368.     
  369.  
  370.  
  371. # Remove text from window, transform, and insert back into window.
  372. proc fillText {from to} {
  373.     global doubleSpaces
  374.     set text [getText $from $to]
  375.     regexp {^ *} $text front
  376.     set text [string trim $text]
  377.     regsub -all "\[ \t\r\]+" $text " " text
  378.     if {$doubleSpaces} {regsub -all {(\.|\?|\!) } $text {\1  } text}
  379.     regsub -all "\r" [string trimright [breakIntoLines $text]] "\r${front}" text
  380.     return $front$text
  381. }
  382.  
  383. proc paragraphToLine {} {
  384.     global fillColumn
  385.     global leftFillColumn
  386.     set fc $fillColumn
  387.     set lc $leftFillColumn
  388.     set fillColumn 10000
  389.     set leftFillColumn 0
  390.     fillRegion
  391.     set fillColumn $fc
  392.     set leftFillColumn $lc
  393. }
  394.  
  395. proc lineToParagraph {} {
  396.     global fillColumn
  397.     global leftFillColumn
  398.     set fc $fillColumn
  399.     set fillColumn 75
  400.     set lc $leftFillColumn
  401.     set leftFillColumn 0
  402.     fillRegion
  403.     set fillColumn $fc
  404.     set leftFillColumn $lc
  405. }
  406.  
  407.  
  408. #set sentEnd {[.!?](\r| +)}
  409. set sentEnd {(\r\r|[.!?](\r| +))}
  410. set sentBeg {[\r ][A-Z]}
  411.  
  412. proc nextSentence {} {
  413.     global sentBeg sentEnd
  414.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  415.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  416.             goto [expr [lindex $mtch 0]+1]
  417.         }
  418.     }
  419. }
  420.  
  421.  
  422. proc prevSentence {} {
  423.     global sentBeg sentEnd
  424.     if {[catch {search -s -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  425.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  426.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  427.             goto [expr [lindex $mtch 0]+1]
  428.         }
  429.     }
  430. }
  431.  
  432. #===============================================================================
  433. # Called by Alpha to do "soft wrapping"
  434. proc softProc {pos start next} {
  435.     global leftFillColumn
  436.     goto $start
  437.     set finish [paraFinish $start]
  438.     set text [fillText $start $finish]
  439.     if {"${text}\r" != [getText $start $finish]} {
  440.         replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  441.         return 1
  442.     } else {
  443.         return 0
  444.     }
  445. }
  446.  
  447. proc dividingLine {} {
  448.     global mode
  449.     global ${mode}modeVars
  450.     if [info exists ${mode}modeVars(prefixString)] {
  451.         set a [string trim [set ${mode}modeVars(prefixString)]]
  452.     } else {
  453.         set a "#"
  454.     }
  455.     insertText "${a}===============================================================================\r"
  456. }
  457.  
  458.